www.gusucode.com > 星梦奇缘交友网 1 > 星梦奇缘交友网 1.0源码程序/love/Userfreeurl.asp
<!--#include file=conn.asp-->
<!--#include file=config.asp-->
<!--#include file=const.asp-->
<!--#include file=char.asp-->
<%
'=========================================================
' File: userfreeurl.asp
' Version:3.0
' Date: 2005-10-22
' Script Written by xmrxw
'=========================================================
' Copyright (C) 2004,2005 920520.com All rights reserved.
' Web: http://www.920520.com,http://www.xmzxw.com
' Email: info@mssky.com,super@mssky.com
' QQ：10689579 Msn：zdlmicr@hotmail.com
'=========================================================
dim action,urlname,urlgoto
action=Trim(Request("action"))
response.buffer=true
stats="我的二级域名"
call nav()
if not founduser then
Errmsg=Errmsg+"<br>"+"<li>您还没有登陆，请登陆后进行修改。"
founderr=true
end if
if founderr then
call Mslove_error()
else
call tumppages()
strFileName="userfreeurl.asp?action="&action&""
Select Case action
Case "active"
Stats="激活域名"
Call active()
case "activesave"
Stats="激活域名"
Call activesave()
Case "edit"
Stats="解析域名"
Call edittable()
Case "editsave"
Stats="保存解析"
Call editsave()
Case "dele"
Stats="删除域名"
Call delurl()
Case "show"
Stats="查看域名"
Call show()
case else
call main()
End Select
if founderr then call Mslove_error()
end if
call activeonline()
call footer()
sub main()
dim Isdefault
%>
<table width="100%" align=center cellpadding=3 cellspacing=1 class=tableborder1>
<form action="modifyadd.asp?action=updat" method=POST name="theForm">
<tr align="left">
<th height="28" colspan="6" align="center" class=tablebody1><%=stats%></th>
</tr>
<tr align="center">
<td colspan="6" class=tablebody2>您的二级域名：http://your<%=Weburl%> <a href="userfreeurl.asp?action=active">我要注册</a></td>
</tr>
<tr align="center">
<td colspan="6" class=tablebody1>本站DNS：<a href="http://<%=Weburl%>" target="_blank">dns<%=Weburl%></a></td>
</tr>
<tr align="center">
<td height="26" colspan="6" align="center" class=tablebody2>我所有域名</td>
</tr>
<tr align="center">
<td width="30%" height="24" class=tablebody1>二级域名</td>
<td width="40%" class=tablebody1>解析地址</td>
<td width="9%" class=tablebody1>状态</td>
<td width="9%" class=tablebody1>查看</td>
<td width="6%" class=tablebody1>解析</td>
<td width="6%" class=tablebody1>删除</td>
</tr>
<%set rs=server.createobject("adodb.recordset")
sql="select * from Ms_host where Username='"&trim(MemberName)&"'"
rs.open sql,conn,1,1
if not (rs.eof and rs.bof) then
call rspages()
do while not rs.eof and page_count<Cint(MaxPerPage)
%>
<tr align="center">
<td align="left" class=tablebody1><a href="http://<%=rs("Urlname")%><%=Weburl%>" target="_blank">http://<%=rs("Urlname")%><%=Weburl%></a></td>
<td align="left" class=tablebody1><%=rs("Urlgoto")%></td>
<td align="center" class=tablebody1><%if rs("Isdefault")=1 then
response.write("<font color=red>系统</font>")
else
response.Write("用户")
end if%></td>
<td align="center" class=tablebody1><a href="Userfreeurl.asp?action=show&id=<%=rs("id")%>">查看</a></td>
<td align="center" class=tablebody1><a href="Userfreeurl.asp?action=edit&id=<%=rs("id")%>" title=解析><img src="images/editurl.gif" width="27" height="21" border="0"></a></td>
<td align="center" class=tablebody1><a href="Userfreeurl.asp?action=dele&id=<%=rs("id")%>" title=删除><img src="images/deleurl.gif" width="21" height="21" border="0"></a></td>
</tr>
<%page_count=page_count+1
rs.movenext
loop
end if
%>
<tr align="center">
<td colspan="6" align="left" class=tablebody1><%if totalrec>0 then
call showpage(strFileName)
end if%></td>
</tr>
<tr align="center">
<td colspan="6" align="left" class=tablebody1> </td>
</tr>
<tr align="center">
<td colspan="6" align="left" class=tablebody1> </td>
</tr>
</form>
</table>
<%
end sub
sub active()''激活域名
dim domain,isstore
domain=checkStr(Request("domain"))
%>
<table width="100%" align=center cellpadding=3 cellspacing=1 class=tableborder1>
<form action="userfreeurl.asp?action=active" method=POST name="theForm">
<tr align="left">
<th width="100%" height="28" align="center" class=tablebody1><%=stats%></th>
</tr>
<tr align="center">
<td width="100%" class=tablebody2>域名查询： <input name="domain" type="text" id="domain" size="20" maxlength="50">
<input type="submit" name="Submit" value="搜索"></td>
</tr>
<%
if domain="" or strLength(request("domain"))>50 then
response.Write("<tr align=""center""><td class=tablebody1 align=""center"">请输入域名长度不大于50个字符</td></tr>")
isstore=2
else
sql="select id from Ms_host where Urlname='"&domain&"'"
set rs=conn.execute(sql)
if not (rs.eof and rs.bof) then
isstore=1
else
isstore=0
end if
rs.close
end if
if isstore=1 then%>
<tr align="center">
<td class=tablebody1 align="center"><font color="#FF0000">对不起</font>！域名已存在</td>
</tr>
<%end if
if isstore=0 then%>
<tr align="center">
<td class=tablebody1 align="center"><font color="#FF0000">恭喜您！</font>可以注册该域名！</td>
</tr>
<tr align="center">
<td class=tablebody1 align="center">您的域名：
<%response.write domain%>
<a href="userfreeurl.asp?action=activesave&urlname=<%=domain%>">激活</a>
</td>
</tr>
<%end if%>
</form>
</table>
<%end sub
sub activesave()''激活保存
if cint(GroupSetting(199))=0 then
errmsg=errmsg+"<br>"+"<li>你没有使用二级域名的权限，请与管理员联系。"
founderr=true
end if
if Chkvalue(1,GroupSetting(201),Cint(GroupSetting(202)))=false then
errmsg=errmsg+"<br>"+"<li>对不起，您的金币不够请确认。"
founderr=true
end if
if Chkvalue(2,GroupSetting(203),Cint(GroupSetting(204)))=false then
errmsg=errmsg+"<br>"+"<li>对不起，您的魅力值不够请确认。"
founderr=true
end if
if Chkvalue(3,GroupSetting(205),Cint(GroupSetting(206)))=false then
errmsg=errmsg+"<br>"+"<li>对不起，您的经验值不够请确认。"
founderr=true
end if
dim domain
domain=checkStr(Request("urlname"))
if domain="" or strLength(request("domain"))>50 then
errmsg=errmsg+"<br>"+"<li>请输入域名(长度不能大于50)。"
founderr=true
end if
if instr(freeurl,domain)>0 then
errmsg=errmsg+"<br>"+"<li>对不起，你注册的域名有系统不允许的名称。"
founderr=true
end if
if founderr=true then exit sub
sql="Insert into Ms_host (Username,UrlName) VALUES ('"&trim(MemberName)&"','"&domain&"')"
sucmsg=sucmsg+"<br>"+"<li><b>您已经成功注册域名。"
call Mslove_suc()
conn.execute(sql)
end sub
sub edittable()''解析域名
dim id
id=checkStr(Request("id"))
if id="" or not isnumeric(id) then
errmsg=errmsg+"<br>"+"<li>参数错误。"
founderr=true
end if
if founderr=true then exit sub
set rs=server.createobject("adodb.recordset")
sql="select Urlname,Urlgoto,Urlms,Isdefault from Ms_host where Username='"&trim(MemberName)&"' and id="&id&""
rs.open sql,conn,1,1
if not (rs.eof and rs.bof) then
%>
<table width="100%" align=center cellpadding=3 cellspacing=1 class=tableborder1>
<form action="userfreeurl.asp?action=editsave" method=POST name="theForm">
<tr>
<th height="28" colspan="2" align="center" class=tablebody1><%=stats%></th>
</tr>
<tr>
<td colspan="2" align="center" class=tablebody2>添加解析新域名</td>
</tr>
<tr>
<td width="29%" class=tablebody1 align="right">绑定的域名：</td>
<td width="71%" class=tablebody1 align="left"><input name="Urlname" type="text" id="Urlname" size="10" maxlength="20" value="<%=rs("Urlname")%>">
<%=Weburl%></td>
</tr>
<input name="id" type="hidden" value="<%=id%>">
<tr>
<td align="right" class=tablebody1>解析地址：</td>
<td align="left" class=tablebody1><input name="Urlgoto" type="text" id="Urlgoto" value="<%=rs("Urlgoto")%>" size="40" maxlength="100">
可以是绝对地址或者相对路径</td>
</tr>
<tr>
<td align="right" class=tablebody1>模式：</td>
<td align="left" class=tablebody1><input name="Urlms" type="radio" value="0" <%if rs("Urlms")=0 then%>checked<%end if%>>
Url跳转
<input type="radio" name="Urlms" value="1" <%if rs("Urlms")=1 then%>checked<%end if%>>
隐藏解析</td>
</tr>
<tr>
<td align="right" class=tablebody1>默认：</td>
<td align="left" class=tablebody1><input type="radio" name="Isdefault" value="1" <%if rs("Isdefault")=1 then%>checked<%end if%>>
是 <input name="Isdefault" type="radio" value="0" <%if rs("Isdefault")=0 then%>checked<%end if%>>
否（默认为用户资料展示页地址）</td>
</tr>
<tr>
<td height="48" align="right" class=tablebody1><font color="#FF0000">注示：</font></td>
<td class=tablebody1>Url跳转模式例：test目录，解析地址：test/或者test/default.asp。<br>
隐藏解析模式例： 解析地址：http://www.xxxx.com标准的域名<br>
默认，为本站用户资料显示地址：dispuser.asp?username=<%=trim(MemberName)%></td>
</tr>
<tr>
<td colspan="2" align="center" class=tablebody1> <input class=2 type=Submit value="保存" name=Submit2>
<input class=2 type="reset" name="Clear" value="清除"></td>
</tr>
</form>
</table>
<%else
errmsg=errmsg+"<br>"+"<li>对不起，没有该域名。"
founderr=true
exit sub
end if
rs.close
end sub
sub editsave()'' 保存解析的域名
dim id,Urlname,Urlgoto,Urlms,Isdefault
id=checkStr(Request("id"))
Urlname=checkStr(Request("Urlname"))
Urlgoto=checkStr(Request("Urlgoto"))
if id="" or not isnumeric(id) then
errmsg=errmsg+"<br>"+"<li>参数错误。"
founderr=true
end if
if Urlname="" or strLength(Urlname)>50 then
errmsg=errmsg+"<br>"+"<li>二级域名长度不能为空长度不大于50个字符。"
founderr=true
end if
if request.Form("Isdefault")=0 then
if Urlgoto="" or strLength(Urlgoto)>250 then
errmsg=errmsg+"<br>"+"<li>解析地址长度不能为空长度不大于250个字符。"
founderr=true
end if
end if
if founderr=true then exit sub
set rs=server.createobject("adodb.recordset")
sql="select Urlname,Urlgoto,Urlms,Isdefault from Ms_host where Username='"&trim(MemberName)&"' and id="&id&""
rs.open sql,conn,1,3
if not (rs.eof and rs.bof) then
rs("Urlname")=Urlname
if request.Form("Isdefault")=1 then
rs("Urlgoto")="dispuser.asp?username="&trim(MemberName)&""
else
rs("Urlgoto")=Urlgoto
end if
rs("Urlms")=request.Form("Urlms")
rs("Isdefault")=request.Form("Isdefault")
rs.update()
rs.close
sucmsg=sucmsg+"<br>"+"<li><b>您已经成功解析。"
call Mslove_suc()
else
errmsg=errmsg+"<br>"+"<li>参数错误。"
founderr=true
exit sub
end if
end sub
sub delurl()
dim id
id=checkStr(Request("id"))
if id="" or not isnumeric(id) then
errmsg=errmsg+"<br>"+"<li>参数错误。"
founderr=true
end if
if founderr=true then exit sub
conn.execute("delete from Ms_host where Username='"&trim(membername)&"' and ID="&id&"")
sucmsg=sucmsg+"<br>"+"<li>您已成功删除该域名。"
call Mslove_suc()
end sub
sub show()''查看域名信息
dim id
id=checkStr(Request("id"))
if id="" or not isnumeric(id) then
errmsg=errmsg+"<br>"+"<li>参数错误。"
founderr=true
end if
if founderr=true then exit sub
set rs=server.createobject("adodb.recordset")
sql="select * from Ms_host where id="&id&""
rs.open sql,conn,1,1
if not (rs.eof and rs.bof) then
%>
<table width="100%" align=center cellpadding=3 cellspacing=1 class=tableborder1>
<tr align="left">
<th height="28" colspan="2" align="center" class=tablebody1><%=stats%></th>
</tr>
<tr align="center">
<td colspan="2" class=tablebody2>修改指定的域名信息 </td>
</tr>
<tr align="center">
<td width="27%" class=tablebody1 align="right">绑定的域名：</td>
<td width="73%" class=tablebody1 align="left"><%=rs("Urlname")%></td>
</tr>
<tr align="center">
<td align="right" class=tablebody1> 转向的地址：</td>
<td align="left" class=tablebody1><%=rs("Urlgoto")%></td>
</tr>
<tr align="center">
<td align="right" class=tablebody1>添加的时间：</td>
<td align="left" class=tablebody1><%=rs("Addtime")%></td>
</tr>
<tr align="center">
<td align="right" class=tablebody1>今日访问数：</td>
<td align="left" class=tablebody1><%=rs("Dayclick")%></td>
</tr>
<tr align="center">
<td align="right" class=tablebody1>总访问次数：</td>
<td align="left" class=tablebody1><%=rs("Click")%></td>
</tr>
<tr align="center">
<td align="right" class=tablebody1>日均访问数：</td>
<td align="left" class=tablebody1><%=clng(rs("click")/(DateDiff("d",rs("addtime"),now())+1))%></td>
</tr>
<tr align="center">
<td align="right" class=tablebody1>最后活动时间：</td>
<td align="left" class=tablebody1><%=rs("Lasttime")%></td>
</tr>
<tr align="center">
<td align="right" class=tablebody1>是否默认：</td>
<td align="left" class=tablebody1><%if rs("Isdefault")=1 then
response.write("系统")
else
response.Write("用户")
end if%></td>
</tr>
<tr align="center">
<td colspan="2" align="left" class=tablebody1> </td>
</tr>
</table>
<%end if
rs.close
end sub%>
</body>
</html>